home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSOB_MMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-17  |  16KB  |  526 lines
  1. unit GSOB_MMo;
  2. {-----------------------------------------------------------------------------
  3.                         dBase III/IV Memo File Handler
  4.  
  5.        GSOB_MMO Copyright (c)  Richard F. Griffin
  6.  
  7.        11 August 1992
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all dBase III/IV Memo (.DBT)
  14.        file operations.
  15.  
  16.                    SHAREWARE  -- COMMERCIAL USE RESTRICTED
  17.  
  18.        Changes:
  19.  
  20. ------------------------------------------------------------------------------}
  21. {$O+}
  22.  
  23. interface
  24.  
  25. uses
  26.      {$IFDEF WINDOWS}
  27.         Objects,
  28.      {$ENDIF}
  29.      GSOB_Var,
  30.      GSOB_Dsk,
  31.      GSOB_Obj,
  32.      GSOB_Str;
  33.  
  34. type
  35.  
  36.    moFileStatus = (Invalid, NotOpen, NotUpdated, Updated);
  37.  
  38.    GSR_MoFieldUsed   = record
  39.       DBIV       : integer;
  40.       StartLoc   : integer;
  41.       LenMemo    : longint;
  42.    end;
  43.  
  44.    GSR_MoFieldEmty   = record
  45.       NextEmty   : longint;
  46.       BlksEmty   : longint;
  47.    end;
  48.  
  49.    GSP_dBMemo = ^GSO_dBMemo;
  50.    GSO_dBMemo  = object(GSO_DiskFile)
  51.       TypeMemo     : Byte;            {83 for dBase III; 8B for dBase IV}
  52.       dStatus      : moFileStatus;    {Holds status code of file}
  53.       MemoCollect  : GSP_LineCollection;
  54.       MemoLineRtn  : Byte;
  55.       Memo_Loc     : Longint;         {Current Memo record}
  56.       Memo_Bloks   : word;
  57.       Edit_Lgth    : word;
  58.  
  59.       constructor Init(FName : string; DBVer : byte);
  60.       destructor  Done; virtual;
  61.       procedure   Close; virtual;
  62.       procedure   HuntAvailBlock(numbytes : longint); virtual;
  63.       procedure   MemoBlockRelease(rpt : longint); virtual;
  64.       Function    MemoBlocks(rpt : longint): word; virtual;
  65.       Procedure   MemoClear; virtual;
  66.       procedure   MemoGet(rpt : longint); virtual;
  67.       function    MemoGetLine(linenum : integer) : string; virtual;
  68.       Procedure   MemoInsLine(linenum : integer; st : string); virtual;
  69.       function    MemoLines : integer; virtual;
  70.       function    MemoPut(rpt : longint) : longint; virtual;
  71.       procedure   MemoPutLast; virtual;
  72.       procedure   MemoSetParam(var bl,mc,bc: longint;var fi: boolean); virtual;
  73.       procedure   MemoWidth(l : integer); virtual;
  74.       procedure   Open; virtual;
  75.    end;
  76.  
  77.    GSP_dBMemo3 = ^GSO_dBMemo3;
  78.    GSO_dBMemo3 = object(GSO_dbMemo)
  79.    end;
  80.  
  81.    GSP_dBMemo4 = ^GSO_dBMemo4;
  82.    GSO_dBMemo4 = object(GSO_dbMemo)
  83.       procedure   MemoBlockRelease(rpt : longint); virtual;
  84.       Function    MemoBlocks(rpt : longint): word; virtual;
  85.       procedure   HuntAvailBlock(numbytes : longint); virtual;
  86.       procedure   MemoPutLast; virtual;
  87.       procedure   MemoSetParam(var bl,mc,bc: longint;var fi: boolean); virtual;
  88.    end;
  89.  
  90. {------------------------------------------------------------------------------
  91.                             IMPLEMENTATION SECTION
  92. ------------------------------------------------------------------------------}
  93.  
  94. implementation
  95.  
  96. var
  97.    bCnt,                              {Will hold bytes in memo field}
  98.    bLmt,                              {dB4 = bytes in memo; dB3 = zero}
  99.    lCnt : longint;                    {Counter for line length in characters}
  100.    mCnt,                              {Counter for input buffer char position}
  101.    tcnt  :  longint;                  {Counter for blocks needed}
  102.    fini    : boolean;                 {Flag set when end of memo field found}
  103.    Valu_Line : string;
  104.    Mem_Block : array [0..GS_dBase_MaxMemoRec*2] of byte;    {Output buffer}
  105.    Mem_UsedBlok : GSR_MoFieldUsed absolute Mem_Block;
  106.    Mem_EmtyBlok : GSR_MoFieldEmty absolute Mem_Block;
  107.  
  108. {------------------------------------------------------------------------------
  109.                                 GSO_dBMemo
  110. ------------------------------------------------------------------------------}
  111.  
  112.  
  113. CONSTRUCTOR GSO_dBMemo.Init(FName : string; DBVer : byte);
  114. begin
  115.    GSO_DiskFile.Init(FName+'.DBT',dfReadWrite+dfSharedDenyNone);
  116.    TypeMemo := DBVer;
  117.    Edit_Lgth := 70;
  118.    if dfFileExst then
  119.    begin
  120.       dStatus := NotOpen;             {Set file status to 'Not Open'   }
  121.       MemoCollect := New(GSP_LineCollection, Init(50,10));
  122.    end
  123.    else
  124.    begin
  125.       dStatus := Invalid;
  126.       Error(dosFileNotFound, mmoInitError);
  127.    end;
  128. end;
  129.  
  130. destructor GSO_dBMemo.Done;
  131. begin
  132.    Close;
  133.    Dispose(MemoCollect, Done);
  134.    GSO_DiskFile.Done;
  135. end;
  136.  
  137. PROCEDURE GSO_dBMemo.Close;
  138. begin
  139.    MemoCollect^.FreeAll;
  140.    GSO_DiskFile.Close;
  141.    dStatus := NotOpen;
  142. end;
  143.  
  144. procedure GSO_dBMemo.HuntAvailBlock(numbytes : longint);
  145. var
  146.    BlksReq : integer;
  147.  
  148.    procedure NewDB3Block;
  149.    begin
  150.       with Mem_EmtyBlok do
  151.       begin
  152.          Read(0, Mem_Block, 1);    {read header block from the .DBT}
  153.          Memo_Loc := NextEmty;
  154.          NextEmty := NextEmty + BlksReq;
  155.          Write(0, Mem_Block, 1);
  156.       end;
  157.    end;
  158.  
  159.    procedure OldDB3Block;
  160.    begin
  161.       Memo_Bloks := MemoBlocks(Memo_Loc);
  162.       if Memo_Bloks < BlksReq then NewDB3Block;
  163.    end;
  164.  
  165.  
  166. begin
  167.    BlksReq := (numbytes div GS_dBase_MaxMemoRec)+1;
  168.    if (Memo_Loc > 0) then
  169.       OldDB3Block
  170.    else
  171.       NewDB3Block;
  172.    Memo_Bloks := BlksReq;
  173.    mCnt := 0;
  174. end;
  175.  
  176. Procedure GSO_dBMemo.MemoBlockRelease(rpt : longint);
  177. begin                          {dummy to match GSO_dBMemo4.MemoBlockRelease}
  178. end;
  179.  
  180. Function GSO_dBMemo.MemoBlocks(rpt : longint): word;
  181. var
  182.    match   : boolean;
  183.    blks    : word;
  184.    i       : integer;
  185. begin
  186.    blks := 0;
  187.    match := false;
  188.    Read(rpt, Mem_Block, 1);
  189.    while not match do
  190.    begin
  191.       inc(blks);
  192.       i := 0;
  193.       while (Mem_Block[i] <> EOFMark) and (i < GS_dBase_MaxMemoRec) do
  194.          inc(i);
  195.       if (i >= GS_dBase_MaxMemoRec) then
  196.          Read(-1, Mem_Block, 1)
  197.       else
  198.          match := true;
  199.    end;
  200.    MemoBlocks := blks;
  201. end;
  202.  
  203. Procedure GSO_dBMemo.MemoGet(rpt : longint);
  204. BEGIN                       { Get Memo Field }
  205.    Memo_Loc := rpt;                   {Save starting block number}
  206.    Memo_Bloks := 0;                   {Initialize blocks read}
  207.    if MemoCollect^.Count > 0 then MemoCollect^.FreeAll;
  208.    if (Memo_Loc = 0) then exit;
  209.    Read(Memo_Loc, Mem_Block, 1);
  210.    MemoSetParam(bLmt, mCnt, bCnt, fini);
  211.    lCnt := 0;                         {line length counter}
  212.    while (not fini) do             {loop until done (EOF mark)}
  213.    begin
  214.       inc(Memo_Bloks);
  215.       while (mCnt < GS_dBase_MaxMemoRec) and (fini = false) do
  216.       begin
  217.          case Mem_Block[mCnt] of   {Check for control characters}
  218.             $1A : begin
  219.                      fini := true; {End of Memo field}
  220.                      if lcnt> 0 then
  221.                      begin
  222.                         Valu_Line[0] := chr(lcnt);
  223.                         MemoCollect^.InsertItem($0D,Valu_Line);
  224.                      end;
  225.                   end;
  226.             $8D : begin            {Soft Return (Wordstar and dBase editor)}
  227.                      if (Valu_Line[lCnt] <> ' ') and
  228.                         (Valu_Line[lCnt] <> '-') and
  229.                         (lCnt > 0) then
  230.                      begin
  231.                         inc(lCnt); {Add to line length count}
  232.                         Valu_Line[lcnt] := ' ';
  233.                                    {Insert a space in storage}
  234.                      end;
  235.                   end;
  236.             $0A : begin            {Linefeed}
  237.                   end;             {Ignore these characters}
  238.             $0D : begin            {Hard Return}
  239.                      Valu_Line[0] := chr(lcnt);
  240.                      MemoCollect^.InsertItem($0D,Valu_Line);
  241.                      lCnt := 0;
  242.                   end;
  243.             else                   {Here for other characters}
  244.             begin
  245.                inc(lCnt);          {Add to line length count}
  246.                Valu_Line[lcnt] :=  chr(Mem_Block[mCnt]);
  247.                                    {Insert the character in storage}
  248.             end;
  249.          end;
  250.          if lCnt > Edit_Lgth then
  251.                                    {If lcnt longer than Memo_Width, you}
  252.                                    {must word wrap to Memo_Width length}
  253.                                    {or less}
  254.          begin
  255.             while (Valu_Line[lCnt] <> ' ') and
  256.                   (Valu_Line[lCnt] <> '-') and
  257.                   (lCnt > 0) do dec(lCnt);
  258.                                    {Repeat search for space or hyphen until}
  259.                                    {found or current line exhausted}
  260.             if (lCnt = 0) then lcnt := Edit_Lgth;
  261.                                    {If no break point, truncate line}
  262.             Valu_Line[0] := chr(lcnt);
  263.             MemoCollect^.InsertItem($8D,Valu_Line);
  264.             Valu_Line[0] := chr(Edit_Lgth+1);
  265.             system.delete(Valu_Line,1,lCnt);
  266.             lCnt := byte(Valu_Line[0]);
  267.          end;
  268.          inc(mCnt);                {Step to next input buffer location}
  269.          inc(bCnt);                {Increment total bytes read}
  270.          if not fini and (bCnt = bLmt) then
  271.          begin
  272.             fini := true; {End of Memo field}
  273.             if lcnt> 0 then
  274.             begin
  275.                Valu_Line[0] := chr(lcnt);
  276.                MemoCollect^.InsertItem($0D,Valu_Line);
  277.             end;
  278.          end;
  279.       end;
  280.       if not fini then Read(Memo_Loc+Memo_Bloks, Mem_Block, 1);
  281.       mCnt := 0;                   {Counter into disk read buffer}
  282.    end;
  283. END;                        { Get Memo Field }
  284.  
  285.  
  286. function GSO_dBMemo.MemoGetLine(linenum : integer) : string;
  287. var
  288.    P : GSP_LineBuf;
  289. begin
  290.    P := MemoCollect^.At(linenum);
  291.    if P <> nil then
  292.    begin
  293.       MemoGetLine := P^.LineText;
  294.       MemoLineRtn := P^.LineRetn;
  295.    end
  296.       else MemoGetLine := '';
  297. end;
  298.  
  299. Procedure GSO_dBMemo.MemoInsLine(linenum : integer; st : string);
  300. begin
  301.    if linenum < 0 then MemoCollect^.InsertItem($0D,st)
  302.       else if linenum < MemoCollect^.Count then
  303.           MemoCollect^.InsertItemAt($0D,st,linenum);
  304. end;
  305.  
  306. Function GSO_dBMemo.MemoLines : integer;
  307. begin
  308.    MemoLines := MemoCollect^.Count;
  309. end;
  310.  
  311. Procedure GSO_dBMemo.MemoClear;
  312. begin
  313.    if MemoCollect^.Count > 0 then MemoCollect^.FreeAll;
  314. end;
  315.  
  316. Function GSO_dBMemo.MemoPut(rpt : longint) : longint;
  317. var
  318.    rsl : word;
  319.    i,j : integer;
  320.    P : GSP_LineBuf;
  321. BEGIN                       { Put Memo Field }
  322.    i := 0;
  323.    repeat
  324.       if dfFileShrd then
  325.          rsl := LockRec(0,1)
  326.       else rsl := 0;
  327.       inc(i);
  328.    until (rsl = 0) or (i = 10);
  329.    if i = 10 then Error(dosAccessDenied,mmoMemoPutError);
  330.    Memo_Loc := rpt;
  331.    bCnt := MemoCollect^.ByteCount;      {Get count of bytes in memo field}
  332.    if bcnt = 0 then
  333.    begin
  334.       MemoPut := 0;
  335.       rsl := UnLock;
  336.       exit;
  337.    end;
  338.    HuntAvailBlock(bCnt);
  339.    lCnt := 0;                         {line length counter}
  340.    tCnt := Memo_Loc;
  341.    j := Memolines-1;
  342.    for i := 0 to j do
  343.    begin
  344.       P := MemoCollect^.At(i);
  345.       if P <> nil then
  346.       begin
  347.          Valu_Line := P^.LineText;
  348.          Move(Valu_Line[1],Mem_Block[mCnt],ord(Valu_Line[0]));
  349.          mCnt := mCnt + length(Valu_Line);
  350.          Mem_Block[mCnt] := P^.LineRetn;
  351.          Mem_Block[mCnt+1] := $0A;
  352.          inc(mCnt,2);
  353.          if (mCnt > GS_dBase_MaxMemoRec) then
  354.          begin
  355.             Write(tcnt, Mem_Block, 1);   {Write a block to the .DBT}
  356.             inc(tcnt);
  357.             mCnt := mCnt mod GS_dBase_MaxMemoRec;
  358.                                       {Get excess buffer length used}
  359.             Move(Mem_Block[GS_dBase_MaxMemoRec],Mem_Block[0],mCnt);
  360.                                       {Move excess to beginning of buffer}
  361.          end;
  362.       end;
  363.    end;
  364.    if (mCnt = GS_dBase_MaxMemoRec) then
  365.    begin
  366.       Write(tcnt, Mem_Block, 1);   {Write a block to the .DBT}
  367.       inc(tcnt);
  368.       mCnt := 0;
  369.    end;
  370.    MemoPutLast;
  371.    if (mCnt < GS_dBase_MaxMemoRec) then
  372.       FillChar(Mem_Block[mcnt],GS_dBase_MaxMemoRec - mcnt,#0);
  373.    Write(tcnt, Mem_Block, 1);        {Write the last block to the .DBT}
  374.    MemoPut := Memo_Loc;
  375.    rsl := UnLock;
  376. end;
  377.  
  378. Procedure GSO_dBMemo.MemoPutLast;
  379. begin
  380.    Mem_Block[mCnt] := EOFMark;
  381.    inc(mCnt);
  382.    Mem_Block[mCnt] := EOFMark;
  383.    inc(mCnt);
  384. end;
  385.  
  386. Procedure GSO_dBMemo.MemoSetParam(var bl,mc,bc: longint;var fi: boolean);
  387. begin
  388.    bLmt := 0;
  389.    mCnt := 0;                   {Counter into disk read buffer}
  390.    bCnt := 0;
  391.    fini := false;                     {Reset done flag to false}
  392. end;
  393.  
  394.  
  395. Procedure GSO_dBMemo.MemoWidth(l : integer);
  396. begin
  397.    Edit_Lgth := l;
  398. end;
  399.  
  400. PROCEDURE GSO_dBMemo.Open;
  401. BEGIN
  402.    if dStatus <= NotOpen then
  403.    begin
  404.       Reset(GS_dBase_MaxMemoRec);     {If memo file, then open .DBT file}
  405.       dStatus := NotUpdated;
  406.    end;
  407. END;
  408.  
  409. {------------------------------------------------------------------------------
  410.                                 GSO_dBMemo4
  411. ------------------------------------------------------------------------------}
  412.  
  413. procedure GSO_dBMemo4.HuntAvailBlock(numbytes : longint);
  414. var
  415.    BlksReq : integer;
  416.    WBlok1  : longint;
  417.    WBlok2  : longint;
  418.    WBlok3  : longint;
  419.  
  420.    procedure FitDB4Block;
  421.    var
  422.       match   : boolean;
  423.    begin
  424.       match := false;
  425.       Read(0, Mem_Block, 1);    {read header block from the .DBT}
  426.       WBlok3 := FileSize;
  427.       if WBlok3 = 0 then     {empty file, fill up header block}
  428.       begin
  429.          inc(WBlok3);
  430.          FillChar(Mem_Block[24],GS_dBase_MaxMemoRec-24,#0);
  431.          Write(0, Mem_Block, 1);
  432.       end;
  433.       with Mem_EmtyBlok do
  434.       begin
  435.          WBlok1 := NextEmty;
  436.          WBlok2 := 0;
  437.          while not match and (WBlok1 <> WBlok3) do
  438.          begin
  439.             Read(WBlok1,Mem_Block,1);
  440.             if BlksEmty >= BlksReq then
  441.             begin
  442.                match := true;
  443.                WBlok3 := NextEmty;
  444.                if BlksEmty > BlksReq then      {free any blocks not needed}
  445.                begin
  446.                   WBlok3 := WBlok1+BlksReq;
  447.                   BlksEmty := BlksEmty - BlksReq;
  448.                   Write(WBlok3,Mem_Block,1);
  449.                end;
  450.             end
  451.             else                            {new memo won't fit this chunk}
  452.             begin
  453.                WBlok2 := WBlok1;            {keep previous available chunk}
  454.                WBlok1 := NextEmty;          {get next available chunk}
  455.             end;
  456.          end;
  457.          if not match then WBlok3 := WBlok3 + BlksReq;
  458.          Read(WBlok2, Mem_Block, 1);
  459.          NextEmty := WBlok3;
  460.          Write(WBlok2, Mem_Block, 1);
  461.       end;
  462.    end;
  463.  
  464. begin
  465.    BlksReq := ((numbytes+8) div GS_dBase_MaxMemoRec)+1;
  466.    if (Memo_Loc > 0) then MemoBlockRelease(Memo_Loc);
  467.    FitDB4Block;
  468.    Memo_Loc := WBlok1;
  469.    Memo_Bloks := BlksReq;
  470.    Mem_UsedBlok.DBIV := -1;
  471.    Mem_UsedBlok.StartLoc:= 8;
  472.    Mem_UsedBlok.LenMemo := numbytes+8;
  473.    mCnt := 8;
  474. end;
  475.  
  476. Procedure GSO_dBMemo4.MemoBlockRelease(rpt : longint);
  477. var
  478.    blks     : word;
  479. begin
  480.    blks := MemoBlocks(rpt);
  481.    with Mem_EmtyBlok do
  482.    begin
  483.       Read(0, Mem_Block, 1);
  484.       BlksEmty := blks;
  485.       Write(rpt, Mem_Block, 1);
  486.       NextEmty := rpt;
  487.       BlksEmty := 0;
  488.       Write(0, Mem_Block, 1);
  489.    end;
  490. end;
  491.  
  492. Function GSO_dBMemo4.MemoBlocks(rpt : longint): word;
  493. var
  494.    blks : word;
  495. begin
  496.    blks := 0;
  497.    with Mem_UsedBlok do
  498.    begin
  499.       Read(rpt, Mem_Block, 1);
  500.       if DBIV = -1 then
  501.          blks := (LenMemo div GS_dBase_MaxMemoRec)+1;
  502.    end;
  503.    MemoBlocks := blks;
  504. end;
  505.  
  506. Procedure GSO_dBMemo4.MemoPutLast;
  507. begin
  508. end;
  509.  
  510. Procedure GSO_dBMemo4.MemoSetParam(var bl,mc,bc: longint;var fi: boolean);
  511. begin
  512.    if Mem_UsedBlok.DBIV = -1 then
  513.    begin
  514.       bLmt := Mem_UsedBlok.LenMemo;
  515.       mCnt := Mem_UsedBlok.StartLoc;
  516.       bCnt := mCnt;                   {init total byte count}
  517.       fini := bCnt = bLmt;            {test for zero bytes in memo}
  518.    end
  519.    else Error(gsBadDBTRecord, mmoMemoSetParamErr);
  520. end;
  521.  
  522.  
  523. end.
  524. {-----------------------------------------------------------------------------}
  525.                                      END
  526.